home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / scripts / autofrisk next >
Encoding:
Text File  |  2004-01-06  |  7.8 KB  |  222 lines
  1. #!/bin/sh
  2. # aside from this initial boilerplate, this is actually -*- scheme -*- code
  3. main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
  4. exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
  5. !#
  6. ;;; autofrisk --- Generate module checks for use with auto* tools
  7.  
  8. ;;     Copyright (C) 2002 Free Software Foundation, Inc.
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License as
  12. ;; published by the Free Software Foundation; either version 2, or
  13. ;; (at your option) any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this software; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  23. ;; Boston, MA 02111-1307 USA
  24.  
  25. ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; Usage: autofrisk [file]
  30. ;;
  31. ;; This program looks for the file modules.af in the current directory
  32. ;; and writes out modules.af.m4 containing autoconf definitions.
  33. ;; If given, look for FILE instead of modules.af and output to FILE.m4.
  34. ;;
  35. ;; After running autofrisk, you should add to configure.ac the lines:
  36. ;;   AUTOFRISK_CHECKS
  37. ;;   AUTOFRISK_SUMMARY
  38. ;; Then run "aclocal -I ." to update aclocal.m4, and finally autoconf.
  39. ;;
  40. ;; The modules.af file consists of a series of configuration forms (Scheme
  41. ;; lists), which have one of the following formats:
  42. ;;   (files-glob PATTERN ...)
  43. ;;   (non-critical-external MODULE ...)
  44. ;;   (non-critical-internal MODULE ...)
  45. ;;   (programs (MODULE PROG ...) ...)
  46. ;;   (pww-varname VARNAME)
  47. ;; PATTERN is a string that may contain "*" and "?" characters to be
  48. ;; expanded into filenames.  MODULE is a list of symbols naming a
  49. ;; module, such as `(srfi srfi-1)'.  VARNAME is a shell-safe name to use
  50. ;; instead of "probably_wont_work", the default.  This var is passed to
  51. ;; `AC_SUBST'.  PROG is a string.
  52. ;;
  53. ;; Only the `files-glob' form is required.
  54. ;;
  55. ;; TODO: Write better commentary.
  56. ;;       Make "please see README" configurable.
  57.  
  58. ;;; Code:
  59.  
  60. (define-module (scripts autofrisk)
  61.   :autoload (ice-9 popen) (open-input-pipe)
  62.   :use-module (srfi srfi-1)
  63.   :use-module (srfi srfi-8)
  64.   :use-module (srfi srfi-13)
  65.   :use-module (srfi srfi-14)
  66.   :use-module (scripts read-scheme-source)
  67.   :use-module (scripts frisk)
  68.   :export (autofrisk))
  69.  
  70. (define *recognized-keys* '(files-glob
  71.                             non-critical-external
  72.                             non-critical-internal
  73.                             programs
  74.                             pww-varname))
  75.  
  76. (define (canonical-configuration forms)
  77.   (let ((chk (lambda (condition . x)
  78.                (or condition (apply error "syntax error:" x)))))
  79.     (chk (list? forms) "input not a list")
  80.     (chk (every list? forms) "non-list element")
  81.     (chk (every (lambda (form) (< 1 (length form))) forms) "list too short")
  82.     (let ((un #f))
  83.       (chk (every (lambda (form)
  84.                     (let ((key (car form)))
  85.                       (and (symbol? key)
  86.                            (or (eq? 'quote key)
  87.                                (memq key *recognized-keys*)
  88.                                (begin
  89.                                  (set! un key)
  90.                                  #f)))))
  91.                   forms)
  92.            "unrecognized key:" un))
  93.     (let ((bunched (map (lambda (key)
  94.                           (fold (lambda (form so-far)
  95.                                   (or (and (eq? (car form) key)
  96.                                            (cdr form)
  97.                                            (append so-far (cdr form)))
  98.                                       so-far))
  99.                                 (list key)
  100.                                 forms))
  101.                         *recognized-keys*)))
  102.       (lambda (key)
  103.         (assq-ref bunched key)))))
  104.  
  105. (define (>>strong modules)
  106.   (for-each (lambda (module)
  107.               (format #t "GUILE_MODULE_REQUIRED~A\n" module))
  108.             modules))
  109.  
  110. (define (safe-name module)
  111.   (let ((var (object->string module)))
  112.     (string-map! (lambda (c)
  113.                    (if (char-set-contains? char-set:letter+digit c)
  114.                        c
  115.                        #\_))
  116.                  var)
  117.     var))
  118.  
  119. (define *pww* "probably_wont_work")
  120.  
  121. (define (>>weak weak-edges)
  122.   (for-each (lambda (edge)
  123.               (let* ((up (edge-up edge))
  124.                      (down (edge-down edge))
  125.                      (var (format #f "have_guile_module~A" (safe-name up))))
  126.                 (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up)
  127.                 (format #t "test \"$~A\" = no &&\n  ~A=\"~A $~A\"~A"
  128.                         var *pww* down *pww* "\n\n")))
  129.             weak-edges))
  130.  
  131. (define (>>program module progs)
  132.   (let ((vars (map (lambda (prog)
  133.                      (format #f "guile_module~Asupport_~A"
  134.                              (safe-name module)
  135.                              prog))
  136.                    progs)))
  137.     (for-each (lambda (var prog)
  138.                 (format #t "AC_PATH_PROG(~A, ~A)\n" var prog))
  139.               vars progs)
  140.     (format #t "test \\\n")
  141.     (for-each (lambda (var)
  142.                 (format #t " \"$~A\" = \"\" -o \\\n" var))
  143.               vars)
  144.     (format #t "~A &&\n~A=\"~A $~A\"\n\n"
  145.             (list-ref (list "war = peace"
  146.                             "freedom = slavery"
  147.                             "ignorance = strength")
  148.                       (random 3))
  149.             *pww* module *pww*)))
  150.  
  151. (define (>>programs programs)
  152.   (for-each (lambda (form)
  153.               (>>program (car form) (cdr form)))
  154.             programs))
  155.  
  156. (define (unglob pattern)
  157.   (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
  158.     (map symbol->string (read p))))
  159.  
  160. (define (>>checks forms)
  161.   (let* ((cfg (canonical-configuration forms))
  162.          (files (apply append (map unglob (cfg 'files-glob))))
  163.          (ncx (cfg 'non-critical-external))
  164.          (nci (cfg 'non-critical-internal))
  165.          (prog (cfg 'non-critical))
  166.          (report ((make-frisker) files))
  167.          (external (report 'external)))
  168.     (let ((pww-varname (cfg 'pww-varname)))
  169.       (or (null? pww-varname) (set! *pww* (car pww-varname))))
  170.     (receive (weak strong)
  171.         (partition (lambda (module)
  172.                      (or (member module ncx)
  173.                          (every (lambda (i)
  174.                                   (member i nci))
  175.                                 (map edge-down (mod-down-ls module)))))
  176.                    external)
  177.       (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
  178.       (>>strong strong)
  179.       (format #t "\n~A=~S\n\n" *pww* "")
  180.       (>>weak (fold (lambda (module so-far)
  181.                       (append so-far (mod-down-ls module)))
  182.                     (list)
  183.                     weak))
  184.       (>>programs (cfg 'programs))
  185.       (format #t "AC_SUBST(~A)\n])\n\n" *pww*))))
  186.  
  187. (define (>>summary)
  188.   (format #t
  189.           (symbol->string
  190.            '#{
  191. AC_DEFUN([AUTOFRISK_SUMMARY],[
  192. if test ! "$~A" = "" ; then
  193.     p="         ***"
  194.     echo "$p"
  195.     echo "$p NOTE:"
  196.     echo "$p The following modules probably won't work:"
  197.     echo "$p   $~A"
  198.     echo "$p They can be installed anyway, and will work if their"
  199.     echo "$p dependencies are installed later.  Please see README."
  200.     echo "$p"
  201. fi
  202. ])
  203. }#)
  204.           *pww* *pww*))
  205.  
  206. (define (autofrisk . args)
  207.   (let ((file (if (null? args) "modules.af" (car args))))
  208.     (or (file-exists? file)
  209.         (error "could not find input file:" file))
  210.     (with-output-to-file (format #f "~A.m4" file)
  211.       (lambda ()
  212.         (>>checks (read-scheme-source-silently file))
  213.         (>>summary)))))
  214.  
  215. (define main autofrisk)
  216.  
  217. ;; Local variables:
  218. ;; eval: (put 'receive 'scheme-indent-function 2)
  219. ;; End:
  220.  
  221. ;;; autofrisk ends here
  222.